TP 6 MATHEMATICA : ALGORITHMES CLASSIQUES
CORRIGÉ

1) ALGORITHME D'EUCLIDE AVEC CALCUL DES COEFFICIENTS DE BÉZOUT
  Version itérative :

bezout[a_,b_]:=Module[{ u={1,0,a},v={0,1,b},q,t},
While [v[[3]]>0 ,q=Quotient[u[[3]],v[[3]]];{u,v}={v,u-q v}];
Print[u[[3]],"=(",u[[1]],")×",a,"+(",u[[2]],")×",b]]

bezout[17,71]
bezout[45 7 13,11 7 13]

Version récursive (avec affichage des intermédiaires) :

bezoutr[u_,v_,a_,b_]:=Module[ {q},
Print[u,v];If [v[[3]]==0 ,Print[u[[3]],"=(",u[[1]],")×",a,"+(",u[[2]],")×",b],q=Quotient[u[[3]],v[[3]]];bezoutr[v,u-q*v,a,b]]];
bezout[a_,b_]:=bezoutr[{1,0,a},{0,1,b},a,b]

bezout[17,71]

2) PRIMALITÉ D' UN ENTIER

estpremier[n_]:=Module[{ k=2},
While [Mod[n ,k]!=0 And k^2≤n ,k++];k^2>n ];
estpremier[1234567]

Une légère modification donne le plus petit diviseur premier

pluspetitdiviseurpremier[n_]:=Module[{ k=2},
While [Mod[n ,k]!=0 And k^2≤n ,k++];If[k^2>n,k=n];k];
pluspetitdiviseurpremier[1234567]

3) LISTE DES PREMIERS

listepremiers[n_]:=Module[{ P=Range[2,n],p=2,m=n,k=1},
While [p^2≤m , p=P[[k]];m=Max[P];P=Complement[P,Table[k p,{k,p,m/p}]];k++];
P];listepremiers[100]

4) DÉCOMPOSITION DANS UNE BASE

Version récursive

dec[n_,b_]:=
If [n==0,{}, Append[dec[Quotient[n,b],b],Mod[n,b]]];
dec[2010,10]
dec[2010,7]
dec[2010,2]
BaseForm[2010,2]

5) EXPONENTIATION RAPIDE 

Version itérative

exporap[a_,n_]:=Module[{ p=1,r,b=a,m=n},
While [m>0 ,r=Mod[m,2];If[ r!=0 , p=p b ];
m=Quotient[m,2];b=b^2 ];
p];

6)  DIVISION EN SYSTÈME DÉCIMAL

Version itérative

f[a_,b_,k_]:=Module[{l={},aa=a,q},Do[
q=Quotient[aa,b];AppendTo[l,q];aa=10Mod[aa,b],{k}];l];

f[2010,7,10]
N[2010/7,12]

Version récursive

f[a_,b_,k_]:=
If [k==0,{},Prepend[f[10Mod[a,b],b,k-1] ,Quotient[a,b]]] ;

f[2010,7,10]

7)  EXTRACTION DE RACINE CARRÉE EN SYSTÈME DÉCIMAL

Version itérative

f[n_,k_]:=Module[{l={},b,r=0,m=n},Do[b=1;
While [(20r+b)b≤m ,b++];b=b-1;
AppendTo[l,b];
m=100(m-(20r+b)b);
r=10r+b ,{k}];l];

f[2010,10]
N[Sqrt[2010],11]

Version récursive

f[n_,r_,k_]:=Module[
{ b},If[ k==0 ,{},b=1;While [(20*r+b)b≤n ,b++];b=b-1;
Prepend[f[100(n-(20r+b)b),10*r+b,k-1] ,b] ]];
f[2,0,10]
N[Sqrt[2],10]

8) DIVISION EUCLIDIENNE DES POLYNÔMES

A=3X^4+X+1;B=2X^2+1;
R=A;Q=0;While[Exponent[R,X]≥Exponent[B,X], Q1=Last[R]/Last[B];R=R-Q1 B//Expand;Q=Q+Q1 ];
TraditionalForm[A==B Q+R]

Version récursive pour le reste :

reste[A_,B_]:=If[Exponent[A,X]<Exponent[B,X],A,reste[A-Last[A]/Last[ B]B,B]]

reste[A,B]

9) ALGORITHME DE HORNER
Version itérative

horner[a_,x_,n_]:=Module[{ y=a[n],k},Do [y=x y+a[n-k],{k,n} ];y]

horner[a,x,5]

Version récursive

hornerrecu[a_,x_,n_,q_]:=If[ n==0 , a[q] ,a[q]+x hornerrecu[a,x,n-1,q+1] ]

hornerrecu[a,x,5,0]

Noter l'obligation (?) de l'ajoût d'une quatrième variable.

10) ALGORITHME EGYPTIEN GLOUTON

Version récursive

glouton[x_]:=Module[ {n},
If[ x==0 ,{},n=Ceiling[1/x];Prepend[glouton[x-1/n],1/n]]];
glouton[1/2+1/7+1/19]
glouton[4/97]

On remarque que l'algorithme glouton ne donne pas forcément la solution ayant le moins de fractions !

11) ALGORITHMES DE TRI

a) par échanges

echange[L_,i_,j_]:=Module[{ M=L},{M[[j]],M[[i]]}={L[[i]],L[[j]]};M];
tri1[L_]:=Module[{ i,j,M=L,n=Length[L]}, Do[If [M[[j]]<M[[i]] , M=echange[M,i,j]], {i , n-1},{j,i+1,n}];M]

b) par insertion

insertion[x_,L_]:=Module[{k=1},While [k≤Length[L] &&x>L[[k] ] ,k++];Insert[L,x,k]]
tri2[L_]:=If[Length[L]==1,L,insertion[L[[1]],tri2[Delete[L,1]]]];

c) par recherche du minimum (idée de Nicolas Polidano, sup 2009) ; utilisation de la fonction Min de mathematica.

rangdumin[L_]:=Module[{ k=1,x=Min[L]},While [L[[k]]>x ,k++];k]
tri3[L_]:=If [Length[L]==1, L ,Prepend[tri3[Delete[L,rangdumin[L]]] ,Min[L]]]

d) par fusion

fusion[L_,M_]:=Module[{ n1=Length[L],n2=Length[M],i=1,j=1,N={}},
While [i≤n1&& j≤n2 ,If[ L[[i]]>M[[j]] , N=Append[N,M[[j]]];j++,N=Append[N,L[[i]]];i++]];Join[N,Drop[L,i-1],Drop[M,j-1]]]

fusion[{1,5,6},{2,4,5}]

fusionne deux listes croissantes en une liste croissante.

tri4[L_]:=Module[ {n=Length[L],m},m=Quotient[n,2];If [n==1 ,L,fusion[tri4[Take[L,m]],tri4[Drop[L,m]]]]]

L=Table[Mod[3^i,10000],{i,1,100}];
Timing[tri1[L];]

Timing[tri2[L];]

Timing[tri3[L];]

Timing[tri4[L];]

Timing[Sort[L];]

CONCLUSION : tri de mathematica > tri par fusion > tri par minimum > tri par insertion > tri par échanges.